home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 33 / 033.d81 / addition master (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  9KB  |  318 lines
  1. 1 ln$="----------"
  2. 2 goto2000
  3. 5 c=ma:ifsx(c)thenu(tr(co(r,c)))=.
  4. 10 ifnthen35
  5. 15 f=.:c=c-1:ifc=.thenreturn
  6. 20 ifsx(c)thenu(tr(co(r,c)))=.
  7. 25 n=nd(c):ifn=.then15
  8. 30 fori=1ton:l(i)=tr(di(c,i)):next
  9. 35 gosub258:iffthen15
  10. 40 fori=1ton:tj=l(i):sj=so(di(c,i)):gosub270:ifa1=.then35
  11. 45 tr(di(c,i))=tj:next
  12. 50 tj=ca(c-1):fori=1tor-1:ifc>len(rw$(i))then65
  13. 52 ifpeek(198)<>0thengosub5000:ifag=1thenrun
  14. 55 ifrp(c)=ithen65
  15. 60 tj=tj+tr(co(i,c))
  16. 65 next:ca(c)=int(tj/10):tj=tj-10*ca(c):ifrp(c)theniftjthen10
  17. 70 ifrp(c)then105
  18. 75 a=co(r,c):ifathenifsx(c)then90
  19. 80 iftj=tr(a)then105
  20. 85 goto10
  21. 90 ifu(tj)then10
  22. 95 sj=so(a):gosub270:ifa1=.then10
  23. 100 tr(a)=tj:u(tj)=1
  24. 105 c=c+1:ifc>mathen120
  25. 110 a1=.:n=nd(c):ifn=.then50
  26. 115 gosub252:goto40
  27. 120 tj=ca(ma):iftj=.thenonlr-ma+1goto155,5
  28. 125 iflr=mathen5
  29. 130 a=co(r,lr):ifsx(c)=.then150
  30. 135 ifu(tj)then5
  31. 140 sj=so(a):gosub270:ifa1=.then5
  32. 145 tr(a)=tj:u(tj)=1:goto155
  33. 150 iftr(a)-tjthen5
  34. 155 n=nd(12):ifn=.then192
  35. 160 gosub252:goto185
  36. 165 ifn=.then175
  37. 170 gosub258:iff=.then185
  38. 175 ifsx(lr)thenu(tr(co(r,lr)))=.
  39. 180 c=ma:f=.:goto20
  40. 185 fori=1ton:tj=l(i):sj=so(di(12,i)):gosub270:ifa1=.then170
  41. 190 tr(di(12,i))=tj:next
  42. 192 fori=1tor:iftr(co(i,len(rw$(i))))=.then165
  43. 195 ifcl(i)=0then230
  44. 200 a=0:fora1=len(rw$(i))to1step-1:a=10*a+tr(co(i,a1)):next
  45. 202 ifcl(i)>2then215
  46. 205 gosub350:ifcl(i)+(a1>0)=1then230
  47. 210 goto165
  48. 215 ifcl(i)>4then230
  49. 220 b=int(sqr(a)*a2):a1=3:ifa=b*bthena1=4
  50. 225 ifcl(i)=a1then165
  51. 230 nexti:b$=ti$:s=s+1:ifs=1thengosub475:goto235:rem solution
  52. 232 print:print"the next solution is ready...":print"press a key to see it."
  53. 233 ifp<4thengosub465
  54. 235 print"[147]";:gosub400:ifpthencmdp:gosub400:print#p
  55. 240 print:print"let me get back to work ...":print"<press a key to quit>"
  56. 245 ti$=b$:goto165
  57. 250 :
  58. 251 rem subroutines
  59. 252 i=1
  60. 253 l(i)=-1
  61. 254 l(i)=l(i)+1:ifu(l(i))thenifl(i)<9then254
  62. 255 ifl(i)=9thenifu(9)then259
  63. 256 u(l(i))=1:ifi<ntheni=i+1:goto253
  64. 257 return
  65. 258 fori=nto1step-1:u(l(i))=.:ifl(i)<9then254
  66. 259 next:f=1:return
  67. 260 :
  68. 265 rem check clues
  69. 270 a1=0:onsj-9goto275,275,280,290,295,300,305
  70. 275 a1=sj+tj+1and1:return
  71. 280 iftj<3thena1=tj
  72. 285 return
  73. 290 a1=1:return
  74. 295 a1=abs(3-abs(tj-5))=1:return
  75. 300 a1=tj:return
  76. 305 a1=abs(2.5-abs(tj-5))-.5:return
  77. 340 :
  78. 345 rem prime test
  79. 350 ifa<4thena1=0:return
  80. 355 ifa/2=int(a/2)thena1=2:return
  81. 360 fora1=3tosqr(a)step2:ifa/a1=int(a/a1)thenreturn
  82. 365 next:a1=0:return
  83. 370 print"[147]";:rem display puzzle
  84. 375 fori=1tor
  85. 380 ifi=rthenprintspc(15-lr)left$(ln$,lr)
  86. 385 printspc(15-len(rw$(i)))rw$(i):next:print
  87. 390 fori=0tonc:printcs$(i):next:print:return
  88. 395 rem display solution
  89. 400 printspc(11)"solution no."s:printspc(9)"==================="
  90. 405 printspc(9)"time so far: "b$:print
  91. 410 fori=1tor:a1=len(rw$(i))
  92. 415 ifi=rthenprintspc(13-lr)left$(ln$,lr)spc(15-lr)left$(ln$,lr)
  93. 420 printspc(13-a1)rw$(i)spc(15-a1);
  94. 425 fora=a1to1step-1:printchr$(48+tr(co(i,a)));:next
  95. 430 print:next:print
  96. 435 fori=1tonm:print"  "in$(i);:next:print
  97. 440 print" ";:fori=1tonm:printtr(i);:next:print
  98. 445 print:fori=1tonc:printcs$(i):next
  99. 450 return
  100. 455 :
  101. 460 rem input and beep
  102. 465 gosub475:rem beep
  103. 470 wait198,3:geta$:poke198,0
  104. 475 poke54296,15:fori=1to20:next:poke54296,0:return
  105. 490 :
  106. 495 rem enter puzzle
  107. 500 gosub900:goto520
  108. 510 print:print"i can't handle this stuff..."
  109. 520 clr:dimi,c,n,tj,a,a1,sj,r:a2=1+2e-7
  110. 525 ifpeek(828)thenp=4:openp,p
  111. 530 diml(11),u(11),tr(10),di(12,10),rp(11),ca(12),co(11,11),so(10),rw$(11)
  112. 535 dimsx(20),nd(12),sl(20,10),cl(11),cs$(30),sl$(20)
  113. 540 gosub475
  114. 542 print"[155]there must be between 3 and 11 lines,   including the sum."
  115. 545 input"how many lines (0 to quit) ";r:ifr=0thenrun
  116. 550 ifr<3orr>11then510
  117. 555 print:print"enter each line separately:":print
  118. 560 fori=1tor
  119. 565 inputrw$(i):iflen(rw$(i))>10then510
  120. 570 iflen(rw$(i))=0then510
  121. 575 next:print
  122. 580 cs$(0)="                "
  123. 585 lr=len(rw$(r)):gosub370
  124. 590 fori=1tor:b=len(rw$(i)):ifi=rthen610
  125. 600 ifb=mathena1=a1+1
  126. 605 ifb>mathena1=0:ma=b
  127. 610 forn=1tob:a$=left$(right$(rw$(i),n),1)
  128. 615 ifasc(a$)<65thena=0:in$(0)=a$:l(0)=1:goto635
  129. 620 fora=1to10:ifin$(a)=a$then635
  130. 625 ifin$(a)=""thenin$(a)=a$:nm=a:goto635
  131. 630 next:nm=11
  132. 635 co(i,n)=a
  133. 640 nextn,i
  134. 645 ifma>lrorlr>ma+1then510
  135. 650 print"i found"nm"letters:":ifnm<2ornm>10then510
  136. 655 fori=1tonm:print" "in$(i);:so(i)=13:tr(i)=10:next:print
  137. 660 iflr=mathen675
  138. 665 ifa1=1thenso(a)=12
  139. 670 ifa1=0thentr(a)=1:so(a)=1:u(1)=1:l(a)=1:nc=1:cs$(1)=in$(a)+" must be 1"
  140. 675 gosub1000:rem clues
  141. 680 fori=1tor:a=co(i,len(rw$(i))):ifso(a)=13thenso(a)=15
  142. 685 ifso(a)=0thenprintcs$(0):printin$(a)" can't be zero!":goto510
  143. 690 next
  144. 695 gosub370
  145. 700 print"this will take a few minutes--"
  146. 702 print"should i <p>roceed or <c>ancel?"
  147. 705 poke198,0:wait198,1:geta$:ifa$<>"p"anda$<>"c"then705
  148. 715 ifa$="c"then520
  149. 720 :
  150. 725 ti$="000000":print"thinking...":print"<press a key to quit>"
  151. 730 forc=1toma:i=0:forn=1tor-1:ifc>len(rw$(n))then750
  152. 735 a=co(n,c):ifl(a)ora=0then750
  153. 740 ifrp(c)=0thenifa=co(r,c)thenrp(c)=n:goto750
  154. 745 i=i+1:di(c,i)=a:l(a)=1
  155. 750 next:nd(c)=i:ifl(co(r,c))orrp(c)then760
  156. 755 l(co(r,c))=1:sx(c)=1
  157. 760 next:iflr>mathenifl(co(r,lr))=0thenl(co(r,lr))=1:sx(lr)=1
  158. 765 i=0:forc=1toma:a=co(r,c):ifl(a)then775
  159. 770 i=i+1:di(12,i)=a:l(a)=1
  160. 775 next:nd(12)=i:c=1
  161. 800 gosub110:rem solution
  162. 810 b$=ti$:gosub475:print" total time: "b$
  163. 815 ifpthencmdp:print" total time: "b$:print#p
  164. 820 ifsthenprint"no more solutions":goto520
  165. 825 ifpthencmdp:gosub375:print" sorry.. no solution found":print#p
  166. 830 gosub375:print"sorry.. no solution found":goto520
  167. 890 :
  168. 895 rem instructions
  169. 900 print"[147]","addition puzzle":print,"+++++++++++++++":print
  170. 905 print"this program solves alphametic addition puzzles of this type:"
  171. 910 print:print"   was":print"  that":print"   all"
  172. 912 print" -----":print" right"
  173. 915 print:print"each letter stands for a different digit"
  174. 920 print"simply enter the puzzle when prompted."
  175. 925 print"allow several minutes for the solution."
  176. 930 print:print"any clues you can offer will speed the"
  177. 935 print"process.  in this example, r must be 1;"
  178. 940 print"it is given that 'was' must be square."
  179. 950 print"using a printer? y/n"
  180. 955 gosub465:print"[147]"
  181. 960 ifa$<>"y"thenpoke828,0:return
  182. 965 print:print"enter the date (no commas)":inputa$
  183. 967 open15,4,15:close15:ifst<>0then60000
  184. 970 poke828,4:open4,4
  185. 975 print#4,chr$(14)"**addition master** "a$
  186. 980 return
  187. 990 :
  188. 995 rem get clues
  189. 1000 print:print"can you offer any clues? y/n"
  190. 1010 cs$(21)="prime":cs$(22)="not prime":cs$(23)="square"
  191. 1020 cs$(24)="not square":cs$(26)="even":cs$(27)="odd":cs$(28)="1 or 2"
  192. 1030 gosub465:ifa$="n"thenreturn
  193. 1040 gosub370:print:print"press the letter the clue is for."
  194. 1050 print"to specify a line, press the space bar:"
  195. 1060 gosub470:ifa$=" "then1350
  196. 1070 fori=1tonm:ifin$(i)=a$then1100
  197. 1080 next
  198. 1090 printa$"???":goto1330
  199. 1100 print:print"press the value of the letter '"a$"', or..."
  200. 1110 print"a  if even":print"b  if odd":print"c  if it could be 1 or 2"
  201. 1120 wait198,3:getb$:tj=asc(b$)-48+7*(b$>"9")
  202. 1130 iftj<0ortj>12then1090
  203. 1140 sj=so(i):iftj<10then1230
  204. 1150 ifsj<10thenprinta$" is"sj:goto1330
  205. 1160 onsj-9goto1170,1180,1190,1310,1200,1310,1210
  206. 1170 ontj-9goto1090,510,1580
  207. 1180 ontj-9goto510,1090,1570
  208. 1190 ontj-9goto1590,1570,1090
  209. 1200 ontj-9goto510,1310,1570
  210. 1210 ontj-9goto1310,1310,1570
  211. 1230 ifsj=tjthen1090
  212. 1240 ifsj<10then510
  213. 1250 gosub270:ifa1=0then510
  214. 1260 nc=nc+1:cs$(nc)=in$(i)+" must be"+str$(tj)
  215. 1270 u(tj)=1:l(i)=1:tr(i)=tj:so(i)=tj
  216. 1280 forn=1tonm:ifi=nthen1300
  217. 1290 iftj=so(n)thenprint:printin$(i)" & "in$(n)" can't both be"tj:goto510
  218. 1300 next:goto1320
  219. 1310 so(i)=tj:nc=nc+1:cs$(nc)=in$(i)+" must be "+cs$(tj+16)
  220. 1320 print:printcs$(nc)
  221. 1330 print"any more clues? y/n":goto1030
  222. 1340 :
  223. 1350 print:input"line number";a:ifa<1ora>rthen1090
  224. 1360 print:printrw$(a)" - is it:"
  225. 1370 print:print"1 prime?":print"2 not prime?"
  226. 1380 print"3 square?":print"4 not square?"
  227. 1390 print"5 odd?":print"6 even?"
  228. 1400 print"press a number."
  229. 1410 gosub465:b=val(a$):ifb=0orb>6then1090
  230. 1420 i=co(a,1):nc=nc+1:ifb<5then1440
  231. 1430 cs$(nc)=rw$(a)+" is "+cs$(32-b):tj=16-b:a$=in$(i):goto1140
  232. 1440 cl(a)=b:cs$(nc)=rw$(a)+" is "+cs$(b+20)
  233. 1450 iflen(rw$(a))<=8then1460
  234. 1455 cl(a)=0:print"i can't ensure that":cs$(nc)=cs$(nc)+"??"
  235. 1460 iflen(rw$(a))=1then1320
  236. 1470 onbgoto1490,1320,1530,1320
  237. 1